home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 096 / prtrbbs.arc / PRTUSR.BAS < prev   
BASIC Source File  |  1985-08-19  |  5KB  |  94 lines
  1. 10 REM this program prints all of the users in conference and main users
  2. 20 REM files as listed in the file USRFILES.DEF  Also, as an option, this
  3. 30 REM program will reassign security levels for uploads as per the
  4. 40 REM following table:
  5. 42 REM
  6. 44 REM       # Uploads                Security Level Assigned
  7. 46 REM         0-1                              5
  8. 47 REM         2-3                              6
  9. 48 REM         4-5                              7
  10. 49 REM         6-7                              8
  11. 50 REM         8-9                              9
  12. 51 REM         10+                             10
  13. 52 REM
  14. 53 REM If a users security level is already higher that the security level
  15. 54 REM as assigned above, it will not change.  Also, if a user has been
  16. 55 REM assigned a security level less than 5, his security level will not
  17. 56 REM change.  Security levels are only modified for the USERS file (ie -
  18. 57 REM not for the conference users) and only if Y or y is given as a response
  19. 58 REM to the prompt for security level modification.
  20. 60 REM
  21. 80 DIM USFILES$(100)                                      '100 msg files max!
  22. 90 LPP=66                                       'Number of lines per page
  23. 100 CLS:PRINT "RBBS-PC User File Printer":PRINT:PRINT
  24. 105 CHANGESECURITY=0:LINE INPUT "Would you line the security levels modified based on uploads [N] ";A$:IF LEFT$(A$,1)="Y" OR LEFT$(A$,1)="y" THEN CHANGESECURITY=-1
  25. 110 PRINT:LINE INPUT "Turn on the printer - Hit return when ready.......";A$
  26. 120 ON ERROR GOTO 350
  27. 130 OPEN "USRFILES.DEF" FOR INPUT AS #1
  28. 140 J=0
  29. 150 ON ERROR GOTO 0
  30. 160 IF EOF(1) THEN 200                                    'read the file names
  31. 170 J=J+1
  32. 180 LINE INPUT #1,USFILES$(J)
  33. 190 GOTO 160
  34. 200 CLOSE #1:IF J=0 GOTO 360
  35. 210 FOR K=1 TO J
  36. 240 INFILE$=USFILES$(K)
  37. 245 IF INFILE$="" GOTO 280
  38. 250 GOSUB 380
  39. 260 LINES=LINES+1:GOSUB 880
  40. 280 NEXT K                                      'loop till done
  41. 320 LINES=1:GOSUB 880:GOSUB 880
  42. 330 PRINT:PRINT:PRINT" Program finished successfully.......":PRINT:END
  43. 350 CLS:BEEP:PRINT:PRINT:PRINT "ERROR - Can't find USRFILES.DEF":PRINT:PRINT:END
  44. 360 CLS:BEEP:PRINT:PRINT:PRINT "ERROR - No entries in USRFILES.DEF":PRINT:PRINT:END
  45. 370 CLS:BEEP:PRINT:PRINT:PRINT "ERROR - ";INFILE$;" not found.":PRINT:PRINT:END
  46. 375 CLS:BEEP:PRINT:PRINT:PRINT "ERROR - USERS.BAK already exists!":PRINT:PRINT:END
  47. 380 REM *** subroutine to print users ***
  48. 390 ON ERROR GOTO 375
  49. 392 IF INFILE$="USERS" AND CHANGESECURITY THEN INFILE$="USERS.BAK":NAME "USERS" AS "USERS.BAK":MSG=-1 ELSE MSG=0
  50. 395 ON ERROR GOTO 370:PAGE=1:GOSUB 840                        'print message header
  51. 396 OPEN INFILE$ FOR INPUT AS #1:CLOSE #1
  52. 400 OPEN "R",1,INFILE$:FIELD 1,128 AS R$      'open the USERS file
  53. 402 IF MSG THEN OPEN "R",2,"USERS":FIELD 2,128 AS Z$
  54. 410 ON ERROR GOTO 0
  55. 460 REM *** Start printing the USERS ***
  56. 470 ENDFLAG=0:RECNUM=1:USERNUM=0
  57. 480 WHILE RECNUM-1 <> LOF(1)/128
  58. 490 REM --- read message header ---
  59. 500 GET #1,RECNUM:RECNUM=RECNUM+1       'increment record pointer
  60. 510 USNAME$=LEFT$(R$,31)               'get the users name
  61. 520 PASSWORD$=MID$(R$,32,15)            'password
  62. 521 IF LEFT$(USNAME$,1)=" " AND LEFT$(PASSWORD$,1)=" " THEN ENDFLAG=-1
  63. 522 IF LEFT$(USNAME$,1)=" " AND LEFT$(PASSWORD$,1)<>" " THEN SKIP=-1 ELSE SKIP=0
  64. 530 SECURITY$=MID$(R$,47,2)             'security level
  65. 540 CITY$=MID$(R$,63,24)                 'users location
  66. 550 MACHINE$=MID$(R$,87,19)             'users machine type
  67. 560 LASTON$=MID$(R$,106,14)             'last time on
  68. 570 DOWNLOADS$=MID$(R$,123,2)           'number of downloads
  69. 580 UPLOADS$=MID$(R$,125,2)             'number of uploads
  70. 582 REM --- update security if requested ---
  71. 583 SEC=CVI(SECURITY$)
  72. 584 IF NOT MSG GOTO 592
  73. 585 P$=LEFT$(R$,128)
  74. 586 P%=INT(CVI(UPLOADS$)/2)+5:IF SEC<5 GOTO 590 ELSE IF P%>10 GOTO 590 'pass if security <5 OR >10
  75. 588 IF P%>SEC THEN SECURITY$=MKI$(P%):MID$(P$,47,2)=SECURITY$:NEWSEC=-1 ELSE NEWSEC=0
  76. 590 LSET Z$=P$:PUT #2,RECNUM-1
  77. 592 IF ENDFLAG OR SKIP GOTO 820
  78. 620 REM --- print the header information ---
  79. 630 IF LINES>LPP-7 THEN PAGE=PAGE+1:LINES=LINES+1:GOSUB 880:GOSUB 840
  80. 640 GOSUB 860:USERNUM=USERNUM+1:LPRINT USERNUM;USNAME$;" From:";CITY$;" Security:";ASC(SECURITY$)
  81. 660 GOSUB 860:LPRINT " Password: ";PASSWORD$;" Machine: ";MACHINE$;" Last On: ";LASTON$
  82. 670 GOSUB 860:LPRINT " Downloads: ";ASC(DOWNLOADS$);" Uploads: ";ASC(UPLOADS$);
  83. 675 IF NEWSEC THEN LPRINT " *** SECURITY LEVEL UPGRADED ( Was";SEC;") *** " ELSE LPRINT
  84. 680 GOSUB 860:LPRINT
  85. 820 WEND
  86. 829 IF MSG THEN CLOSE #2:MSG=0:CHANGESECURITY=0
  87. 830 CLOSE #1:RETURN
  88. 840 REM *** print user file name and page - page header ***
  89. 850 LPRINT:LPRINT INFILE$;" User File Contents At ";TIME$;" on ";DATE$;TAB(70);"Page";PAGE:LPRINT:LINES=3:RETURN
  90. 860 REM *** subroutine to keep track of number of lines printed ***
  91. 870 LINES=LINES+1:IF LINES=LPP-3 THEN GOSUB 880:PAGE=PAGE+1:GOSUB 840:LINES=LINES+1:RETURN ELSE RETURN
  92. 880 REM subroutine to fill out the page w/ blank lines ***
  93. 890 FOR CT=LINES TO LPP:LPRINT:NEXT CT:RETURN
  94.